Producing charts for ‘The Changing Fortunes of the Richest Countries in Grand Slam Tennis’

# ----------------------------------------------------------------------------
# Reshape data for plotting
# ----------------------------------------------------------------------------
plot_df <- gs_entries_by_country %>% 
  
  # looked performance for two groups of countries
  # top 20% richest countries and the rest
  mutate(top_20_perc = if_else(is.na(top_20_perc), FALSE, top_20_perc)) %>% 
  group_by(year, top_20_perc) %>% 
  summarise(num_first_rd = sum(num_first_rd)) %>% 
  ungroup() %>%
  
  # calculate proportions from counts
  group_by(year) %>% 
  mutate(perc_first_round = num_first_rd / sum(num_first_rd)) %>% 
  ungroup()

# ----------------------------------------------------------------------------
# Produce the plot
# ----------------------------------------------------------------------------  
p <-  ggplot(plot_df) +
  
  # core chart
  geom_area(aes(year, perc_first_round, fill = top_20_perc)) +
  
  # format axis
    scale_y_continuous(labels = scales::percent_format(accuracy = 1L),
                       expand = c(0,0)) +
    scale_x_continuous(expand = c(0,0), 
                       breaks=c(1990,1995,2000,2005,2010,2015,2019)) +
    coord_cartesian(clip = 'off') +
  
  # tidy up presentation
    labs(x = NULL, y = NULL) +
    theme(legend.position = "none",
          plot.margin = margin(25,25,25,25)) 

p 

# ----------------------------------------------------------------------------
# Export the plot for editing
# ----------------------------------------------------------------------------
ggsave("../images/all_gs.svg", units = "mm", width = 600, height = 325)

# ----------------------------------------------------------------------------
# Reshape data for plotting
# ----------------------------------------------------------------------------

# count number of first round appearances per country per year
top_twenty_countries <- gs_entries_by_country %>% 
  filter(top_20_perc) %>% 
  count(year, country, wt = num_first_rd) %>% 
  arrange(year, desc(n)) %>% 
  group_by(country) %>% 
  mutate(country_ave_n = mean(n)) %>% 
  ungroup()

# average number of appearances per country each year (1990 - 2019)
country_ave_ns <- top_twenty_countries %>% 
  distinct(country, country_ave_n)
  
# Count how many time the countries appear in the top twenty percent
top_twenty_counts <- top_twenty_countries %>% 
  count(country) %>% 
  left_join(country_ave_ns) %>% 
  arrange(desc(n), desc(country_ave_n)) %>% 
  rename(years_top_20 = n)
  

# this will be useful later for ordering the countriesin the plot
levels <- top_twenty_counts$country

# create a grid to see where countries have moved out of top 20 perc
grid <-  expand_grid(year = unique(top_twenty_countries$year),
                     country = unique(top_twenty_countries$country))

# identify implicitly missing data
plot_df <- grid %>% 
  left_join(top_twenty_countries)

# identify countries in bottom 80%
bottom_80_countries_by_year <- gs_entries_by_country %>% 
  distinct(year, country, income_decile) %>% 
  filter(income_decile < 9)

# function for checking if a country is the bottom 80% in a given year
check_bottom_80 <- function(year, country){

  selector <- bottom_80_countries_by_year$year == year & 
              bottom_80_countries_by_year$country == country
  
  res <- bottom_80_countries_by_year[selector, ]
  
  if(nrow(res) == 0){
    return(FALSE)
    }
  else {
    return(res[[1,"income_decile"]] < 9)
  }
}

# quick test of check_bottom_80()
check_bottom_80(1990, "Nigeria")

# update plotting dataframe with variable recording if a country is the bottom 80% 
# in a given year
plot_df_1 <- plot_df %>% 
  mutate(in_bottom_80 = map2_lgl(year, country, ~check_bottom_80(.x,.y)),
         n = if_else(is.na(n) & in_bottom_80,
                     -1, n),
         n = replace_na(n, 0),
         bin_n = cut(n, breaks = c(-Inf, -1e-10,0,1e10, 10, 50, 100, Inf)))  

# ----------------------------------------------------------------------------
# Produce the plot
# ----------------------------------------------------------------------------

p <- ggplot(plot_df_1) +
  
      # core plot
      geom_tile(aes(x = year, 
                    y = factor(country, levels = rev(levels)),
                    fill = bin_n),
                colour = "#F8F7F7") +
      
      # plot text
      labs(x= NULL, y = NULL) +
      guides(fill = guide_legend(reverse=TRUE)) +
      
      # colours
      scale_fill_manual(values = c("#E7E4E5", "white", '#cfcde7', 
                                   '#9f9dce', '#6e70b6', '#35469d')) +
      # simplify plot for editting
      scale_x_continuous(position = "top") +
      coord_equal() +  
      theme_minimal()
  
p

# output plot for editing
ggsave("../images/image_4.svg")

# a quick test to confirm that the plot makes sense
gs_entries_by_country %>% 
  filter(country == "Israel") %>% 
  distinct(year, income_decile) %>% 
  scrollable_table()

# ----------------------------------------------------------------------------
# Reshape data for plotting
# ----------------------------------------------------------------------------

# simplify representation of missing data
gs_entries_by_country_clean <- gs_entries_by_country %>% 
  mutate(top_20_perc = if_else(is.na(top_20_perc), FALSE, top_20_perc))

# count first round appearance for all countries by year
all_gs_entries_by_country <- gs_entries_by_country_clean %>% 
  
  group_by(year, country) %>% 
  summarise(num_first_rd_year = sum(num_first_rd)) %>% 
  ungroup() %>% 
  
  left_join(distinct(gs_entries_by_country_clean, country, 
                     year, top_20_perc)) %>%

  group_by(year) %>%
  mutate(perc_first_round = num_first_rd_year / sum(num_first_rd_year)) %>%
  ungroup()

# output to check counts make sense for top 20 vs bottom 80
all_gs_entries_by_country %>% 
  group_by(year, top_20_perc) %>% 
  summarise(perc_first_round = sum(perc_first_round)) %>% 
  scrollable_table()

# focus on top 20 entries
gs_entries_top_20_perc <- all_gs_entries_by_country %>% 
  filter(top_20_perc)

# identify implicitly missing data
grid <- expand_grid(year = unique(gs_entries_top_20_perc$year),
                    country = unique(gs_entries_top_20_perc$country))
  
# create variables needed for plotting
plot_df <- grid %>% 
  left_join(gs_entries_top_20_perc) %>% 
  mutate(perc_first_round = replace_na(perc_first_round, 0)) %>% 
  filter(year <= 2008) %>% 
  mutate(is_usa = country == "United States")

# calculate change in performance (per country) 
# compares number of first round appearance 1990 to 2008
# for grouping, ordering and colouring countries in the area chart
change_df <- plot_df %>% 
  
  filter(year == max(year) | year == min(year)) %>% 
  select(year, country, perc_first_round) %>% 
  
  pivot_wider(names_from = year,
              values_from = perc_first_round,
              values_fill = 0) %>% 
  mutate(change = `2008` - `1990`,
         fall = change < 0,
         change_bin = cut(change, 
                          breaks = c(-Inf, -0.1, -0.02, 0.02, 0.1, Inf))) %>% 
  arrange(change)

# add in change in performance to dataframe for plotting
plot_df_1 <- plot_df %>% 
  
  left_join(change_df) %>% 
  
  group_by(country) %>% 
  mutate(ave_num_first_round = mean(num_first_rd_year, na.rm = TRUE)) %>% 
  ungroup() %>% 

  arrange(fall, desc(change)) %>% 
  mutate(country = factor(country, levels = unique(country)))

# ----------------------------------------------------------------------------
# Produce the plot
# ----------------------------------------------------------------------------

p <- ggplot(plot_df_1) +
  
  # core plot
      geom_area(aes(year, perc_first_round,
                  group = country,
                  fill = change_bin),
              colour = "grey80", size = 0.2) +
    
      # colours
      scale_fill_manual(values = c("#c94a54", "#efb3aa", 
                                   "#fffff0", "#aeabcd")) +
      # format axis
      scale_y_continuous(labels = scales::percent_format(accuracy = 1L),
                         breaks = c(seq(0,0.8,0.1)),
                         expand = expansion(mult = c(0, .1))) +
      scale_x_continuous(expand = c(0,0), 
                         breaks=c(1990,1995,2000,2005,2008)) +
    
      # simplify plot for editting
      labs(x = NULL, y = NULL) +
      theme(legend.position = "none",
            plot.margin = margin(25,25,25,25)) 


p

# output plot for editting
ggsave("../images/image_5.svg", units = "mm", width = 525, height = 350)

# output plot as interactive for inspection
plotly::ggplotly(p)

# ----------------------------------------------------------------------------
# Get the information needed to annotate the plot
# ----------------------------------------------------------------------------

levels(plot_df_1$change_bin)

# get data points for plot annotation
plot_df_1 %>% 
  filter(country %in% c("United States", "Australia", "Sweden")) %>% 
  group_by(year) %>% 
  summarise(perc_first_round_tot = sum(perc_first_round)) %>% 
  scrollable_table()

plot_df_1 %>% 
  filter(country == "United States") %>% 
  group_by(year) %>% 
  summarise(perc_first_round_tot = sum(perc_first_round)) %>% 
  scrollable_table()

# get players from a country in a given year (for annotation)
get_players <- function(country_str, year_int){
  gs_first_round_gdp %>% 
  filter(country == country_str & year == year_int) %>% 
  distinct(name)
}

get_players("United States", 1990) %>% 
  scrollable_table()

get_players("United States", 2008) %>% 
  scrollable_table()

# ----------------------------------------------------------------------------
# Reshape data for plotting
# ----------------------------------------------------------------------------

# focus on 2009 onwards and find implicitly missing data
plot_df <- grid %>% 
  
  left_join(gs_entries_top_20_perc) %>% 
  mutate(perc_first_round = replace_na(perc_first_round, 0)) %>% 
  filter(year > 2008)

# calculate change in performance of coutries between 2009 and 2019
change_df <- plot_df %>% 
  
  filter(year == max(year) | year == min(year)) %>% 
  select(year, country, perc_first_round) %>% 
  
  pivot_wider(names_from = year,
              values_from = perc_first_round,
              values_fill = 0) %>% 
  
  mutate(change = `2019` - `2009`,
         fall = change < 0,
         # create bins for grouping countries
         change_bin = cut(change, 
                          breaks = c(-Inf, -0.1, -0.02, 0.02, 0.1, Inf))) %>% 
  arrange(change)

# define countries of particular interest for in plot
countries_of_int <-  c("United States", "France", "Sweden", "Australia", "Spain")

# group all the other (not of specific interest) countries
plot_df_1 <- plot_df %>% 
  
  left_join(change_df) %>% 
  
  mutate(country = if_else(country %in% countries_of_int, 
                           country, 
                           "Other")) %>% 
  
  group_by(country, year) %>%
  summarise(perc_first_round = sum(perc_first_round)) %>% 
  ungroup()
  
# define order of the facets within the plot
facet_order <- c("United States", "Australia", "Sweden", "France", "Spain", "Other")

# create annotation layer for plot
annotation_df <- plot_df_1 %>% 
  mutate(label = round(perc_first_round * 100, 1),
         num_appearances = round(perc_first_round * 256)) %>% 
  filter(year == max(plot_df_1$year)|
           year == min(plot_df_1$year))
# ----------------------------------------------------------------------------
# Produce the plot
# ----------------------------------------------------------------------------

p <- ggplot(plot_df_1,
            aes(year, perc_first_round)) +
  
      # core plot
      geom_area(aes(group = country),
                colour = "grey80", size = 0.2) +
  
      # annotation
      ggrepel::geom_text_repel(data = annotation_df,
                               mapping = aes(label = num_appearances)) +
      
      # create small multiples
      facet_wrap(~factor(country, levels = facet_order))

p

# ----------------------------------------------------------------------------
# Reshape data for plotting
# ----------------------------------------------------------------------------
gs_first_round_gdp %>% 

  count(year, country, iso) %>% 
  group_by(year) %>% 
  mutate(perc_appear = n / sum(n)) %>% 
  
  filter(iso %in% c("USA", "FRA", "ESP")) %>% 
  
  # --------------------------------------------------------------------------
  # Produce the plot
  # --------------------------------------------------------------------------
  ggplot() +
  geom_line(aes(year, perc_appear, colour = country))

# ----------------------------------------------------------------------------
# Reshape data for plotting
# ----------------------------------------------------------------------------
country_group_counts <- gs_first_round_gdp %>% 
  count(year, country, iso) %>% 
  mutate(colour = if_else(
    iso %in% c("USA", "FRA", "ESP"), iso, "other"
  )) 

# ----------------------------------------------------------------------------
# Produce the plot
# ----------------------------------------------------------------------------
country_group_counts %>% 
  
  ggplot() +
  geom_line(aes(year, n, group = country, colour = colour)) +
      scale_y_continuous(expand = c(0,0)) +
    scale_x_continuous(expand = c(0,0), 
                       breaks=c(1990,1995,2000,2005,2010,2015,2019)) +
    coord_cartesian(clip = 'off') +
  labs(x = NULL, y = NULL) +
  theme(legend.position = "none",
        plot.margin = margin(25,25,25,25),
        panel.grid.minor = element_blank()) 

ggsave("../images/image_7.svg", units = "mm", width = 525, height = 350)

country_group_counts %>% 
  filter(iso == "USA")

top_3 <- gs_first_round_gdp %>% 
  count(year, country) %>% 
  arrange(year, desc(n)) %>% 
  group_by(year) %>% 
  mutate(rank = rank(-n)) %>% 
  ungroup() %>% 
  
  filter(rank == 1 | rank == 2 | rank == 3)